home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Medal Software 3
/
Gold Medal Software - Volume 3 (Gold Medal) (1994).iso
/
prog
/
svgapv20.arj
/
SVGAMOD1.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-03-11
|
30KB
|
1,025 lines
'****************************************************************************
'*
'* 'SVGAQB' & 'SVGAPV' A Super VGA Graphics Librarys for use with
'* MS QuickBASIC 4.X and MS PDS/VBDOS
'* Copyright 1993-1994 by Stephen L. Balkum and Daniel A. Sill
'*
'* MS, QuickBASIC, PDS, and VBDOS are registered trademarks of
'* Microsoft Corporation. GIF and 'Graphics Interchange Format' are
'* trademarks (TM) ofCompuServe, Incorporated, an H&R Block Company.
'*
'* **************** UNREGISTERED SHAREWARE VERSION **********************
'* * FOR EVALUATION ONLY. NOT FOR RESALE IN ANY FORM. SOFTWARE WRITTEN *
'* * USING THIS UNREGISTERED SHAREWARE GRAPHICS LIBRARY MAY NOT BY SOLD *
'* * OR USED FOR ANY PURPOSE OTHER THAN THE EVALUATION OF THIS LIBRARY. *
'* **********************************************************************
'*
'* **************** NO WARRANTIES AND NO LIABILITY **********************
'* * Stephen L. Balkum and Daniel A. Sill provide no warranties, either *
'* * expressed or implied, of merchant ability, or fitness, for a *
'* * particular use or purpose of this SOFTWARE and documentation. *
'* * In no event shall Stephen L. Balkum or Daniel A. Sill be held *
'* * liable for any damages resulting from the use or misuse of the *
'* * SOFTWARE and documentation. *
'* **********************************************************************
'*
'* ************** U.S. GOVERNMENT RESTRICTED RIGHTS *********************
'* * Use, duplication, or disclosure of the SOFTWARE and documentation *
'* * by the U.S. Government is subject to the restrictions as set forth *
'* * in subparagraph (c)(1)(ii) of the Rights in Technical Data and *
'* * Computer Software clause at DFARS 252.227-7013. *
'* * Contractor/manufacturer is Stephen L. Balkum and Daniel A. Sill, *
'* * P.O. Box 7704, Austin, Texas 78713-7704 *
'* **********************************************************************
'*
'* **********************************************************************
'* * By using this SOFTWARE or documentation, you agree to the above *
'* * terms and conditions. *
'* **********************************************************************
'*
'****************************************************************************
REM $INCLUDE: 'SVGABC.BI'
REM $INCLUDE: 'SVGADEMO.BI'
REM $DYNAMIC
SUB DOBLOCK (RET$)
MYPI! = ATN(1) * 4
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 5: Block functions and Sprites"
PALSET Pal, 0, 255
'*************************************************************************
'* SHOW BLOCK GET (DRAW SOME CIRCLES AND "GET A CHUNK OF THEM")
'*************************************************************************
FILLSCREEN (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "BLKGET (X1,Y1,X2,Y2,GfxBlock)"
DRWSTRING 1, 7, 0, A$, 10, 16
Colr = 16
FOR I = 0 TO GETMAXX \ 2
DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
Colr = Colr + 4
IF Colr > 255 THEN
Colr = 16
END IF
NEXT I
XINC = GETMAXX \ 20
YINC = GETMAXY \ 20
X1 = GETMAXX \ 2 - XINC
Y1 = GETMAXY \ 2 - YINC
X2 = GETMAXX \ 2 + XINC
Y2 = GETMAXY \ 2 + YINC
DRWBOX 1, 0, X1, Y1, X2, Y2
BLKGET X1, Y1, X2, Y2, GFXBLK1(0)
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN (0)
EXIT SUB
END IF
'*************************************************************************
'* SHOW BLOCK ROTATE AND SPRITE STUFF
'*************************************************************************
X = (X2 - X1) \ 2 + X1
Y = (Y2 - Y1) \ 2 + Y1
A$ = "BLKROTATE (Angle,BackFill,SourceGfxBlock,DestGfxBlock) "
DRWSTRING 1, 7, 0, A$, 10, 16
A$ = "SPRITEGAP(TranSColr,X,Y,SpriteArray,BackGroundGfxBlock)"
DRWSTRING 1, 7, 0, A$, 10, 32
A$ = "SPRITEPUT(Mode%,TranSColr,X,Y,SpriteArray)"
DRWSTRING 1, 7, 0, A$, 10, 48
FILLAREA X1 + 2, Y1 + 2, 0, 0
BLKGET X1, Y1, X2, Y2, GFXBLK3(0)
SETVIEW 0, 64, GETMAXX, GETMAXY
FOR I = 0 TO 360 STEP 3
DUMMY = BLKROTATE(I, 1, GFXBLK1(0), GFXBLK2(0))
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
SDELAY 4
NEXT I
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
BLKPUT 1, X1, Y1, GFXBLK1(0)
GETKEY RET$
SETVIEW 0, 0, GETMAXX, GETMAXY
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN (0)
EXIT SUB
END IF
'*************************************************************************
'* SHOW BLOCK RESIZE AND SPRITE STUFF
'*************************************************************************
A$ = "BLKRESIZE (NewWidth,NewHeight,SourceGfxBlock,DestGfxBlock) "
DRWSTRING 1, 7, 0, A$, 10, 16
A$ = "SPRITEGAP(TranSColr,X,Y,SpriteArray,BackGroundGfxBlock)"
DRWSTRING 1, 7, 0, A$, 10, 32
A$ = "SPRITEPUT(Mode%,TranSColr,X,Y,SpriteArray)"
DRWSTRING 1, 7, 0, A$, 10, 48
SETVIEW 0, 64, GETMAXX, GETMAXY
FILLAREA X1 + 2, Y1 + 2, 0, 0
BLKGET X1, Y1, X2, Y2, GFXBLK3(0)
FOR I = 0 TO XINC
BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
SDELAY 5
NEXT I
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
FOR I = XINC TO 0 STEP -1
BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
SDELAY 5
NEXT I
SPRITEPUT 1, 1, X - GFXBLK1(0) \ 2, Y - GFXBLK1(1) \ 2, GFXBLK1(0)
BLKGET X1, Y1, X2, Y2, GFXBLK3(0)
FOR I = 0 TO -XINC STEP -1
BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
SDELAY 5
NEXT I
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
FOR I = -XINC TO 0
BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
SDELAY 5
NEXT I
BLKPUT 1, X1, Y1, GFXBLK1(0)
GETKEY RET$
SETVIEW 0, 0, GETMAXX, GETMAXY
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN (0)
EXIT SUB
END IF
'*************************************************************************
'* SHOW BLOCK PUT (PUT THE "CHUNKS" RANDOMLY AROUND THE SCREEN)
'*************************************************************************
SETVIEW 0, 31, GETMAXX, 64
FILLVIEW 0
A$ = "BLKPUT (Mode,X,Y,GfxBlock) "
DRWSTRING 1, 7, 0, A$, 10, 16
XINC = GETMAXX \ 10
YINC = GETMAXY \ 10
SETVIEW 0, 32, GETMAXX, GETMAXY
FOR I = 0 TO GETMAXX \ 2
X = (GETMAXX + XINC) * RND - XINC
Y = (GETMAXY + YINC) * RND - YINC
BLKPUT 1, X, Y, GFXBLK1(0)
NEXT I
GETKEY RET$
SETVIEW 0, 0, GETMAXX, GETMAXY
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN (0)
EXIT SUB
END IF
END SUB
SUB DOCLIP (RET$)
'*************************************************************************
'* SET UP AND SHOW THE TITLE
'*************************************************************************
TITLE$ = "DEMO 2: Clipping capability"
PALSET PAL2, 0, 255
'*************************************************************************
'* SET UP THE WINDOWS
'*************************************************************************
FILLSCREEN (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "All primitives automatically clip"
DRWSTRING 1, 7, 0, A$, 10, 16
WDTH = (GETMAXX + 1) / 2.25
SPCINGX = ((GETMAXX + 1) - WDTH * 2) / 3
HGTH = (GETMAXY + 1 - 35) / 2.25
SPCINGY = ((GETMAXY + 1 - 35) - HGTH * 2) / 3
XINC = WDTH * 1.5
YINC = HGTH * 1.5
XSUB = WDTH * .25
YSUB = HGTH * .25
B1X1 = SPCINGX
B1X2 = B1X1 + WDTH
B1Y1 = SPCINGY + 35
B1Y2 = B1Y1 + HGTH
B2X2 = GETMAXX - SPCINGX
B2X1 = B2X2 - WDTH
B2Y1 = SPCINGY + 35
B2Y2 = B2Y1 + HGTH
B3X2 = GETMAXX - SPCINGX
B3X1 = B3X2 - WDTH
B3Y2 = GETMAXY - SPCINGY
B3Y1 = B3Y2 - HGTH
B4X1 = SPCINGX
B4X2 = B4X1 + WDTH
B4Y2 = GETMAXY - SPCINGY
B4Y1 = B4Y2 - HGTH
DRWBOX 1, 15, B1X1, B1Y1, B1X2, B1Y2
DRWBOX 1, 15, B2X1, B2Y1, B2X2, B2Y2
DRWBOX 1, 15, B3X1, B3Y1, B3X2, B3Y2
DRWBOX 1, 15, B4X1, B4Y1, B4X2, B4Y2
B1X1 = B1X1 + 1
B1Y1 = B1Y1 + 1
B1X2 = B1X2 - 1
B1Y2 = B1Y2 - 1
B2X1 = B2X1 + 1
B2Y1 = B2Y1 + 1
B2X2 = B2X2 - 1
B2Y2 = B2Y2 - 1
B3X1 = B3X1 + 1
B3Y1 = B3Y1 + 1
B3X2 = B3X2 - 1
B3Y2 = B3Y2 - 1
B4X1 = B4X1 + 1
B4Y1 = B4Y1 + 1
B4X2 = B4X2 - 1
B4Y2 = B4Y2 - 1
Colr = 1
'*************************************************************************
'* SHOW THE CLIPPING
'*************************************************************************
FOR I = 0 TO GETMAXX \ 6
FOR J = 1 TO 4
SELECT CASE J
CASE IS = 1
SETVIEW B1X1, B1Y1, B1X2, B1Y2
FOR K = 0 TO 4
X = B1X1 + RND * XINC - XSUB
Y = B1Y1 + RND * XINC - XSUB
DRWPOINT 1, Colr, X, Y
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
NEXT K
CASE IS = 2
SETVIEW B2X1, B2Y1, B2X2, B2Y2
X1 = B2X1 + RND * XINC - XSUB
Y1 = B2Y1 + RND * XINC - XSUB
X2 = B2X1 + RND * XINC - XSUB
Y2 = B2Y1 + RND * XINC - XSUB
DRWLINE 1, Colr, X1, Y1, X2, Y2
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
CASE IS = 3
SETVIEW B3X1, B3Y1, B3X2, B3Y2
X = B3X1 + RND * XINC - XSUB
Y = B3Y1 + RND * XINC - XSUB
RAD = RND * WDTH \ 2
DRWCIRCLE 1, Colr, X, Y, RAD
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
CASE IS = 4
SETVIEW B4X1, B4Y1, B4X2, B4Y2
X = B4X1 + RND * XINC - XSUB
Y = B4Y1 + RND * XINC - XSUB
RADX = RND * WDTH \ 2
RADY = RND * WDTH \ 2
DRWELLIPSE 1, Colr, X, Y, RADX, RADY
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
END SELECT
NEXT J
NEXT I
SETVIEW 0, 0, GETMAXX, GETMAXY
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
EXIT SUB
END IF
END SUB
SUB DOFILL (RET$)
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 3: Filling functions"
PALSET Pal, 0, 255
'*************************************************************************
'* SHOW SCREEN FILL
'*************************************************************************
FILLSCREEN (10)
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "FILLSCREEN (Color)"
DRWSTRING 1, 7, 0, A$, 10, 16
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* SET UP WINDOWS AND SHOW VIEWPORT FILL
'*************************************************************************
FILLSCREEN (0)
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "FILLVIEW (Color)"
DRWSTRING 1, 7, 0, A$, 10, 16
WDTH = (GETMAXX + 1) / 2.25
SPCINGX = ((GETMAXX + 1) - WDTH * 2) / 3
HGTH = (GETMAXY + 1 - 35) / 2.25
SPCINGY = ((GETMAXY + 1 - 35) - HGTH * 2) / 3
XINC = WDTH * 1.5
YINC = HGTH * 1.5
XSUB = WDTH * .25
YSUB = HGTH * .25
B1X1 = SPCINGX
B1X2 = B1X1 + WDTH
B1Y1 = SPCINGY + 35
B1Y2 = B1Y1 + HGTH
B2X2 = GETMAXX - SPCINGX
B2X1 = B2X2 - WDTH
B2Y1 = SPCINGY + 35
B2Y2 = B2Y1 + HGTH
B3X2 = GETMAXX - SPCINGX
B3X1 = B3X2 - WDTH
B3Y2 = GETMAXY - SPCINGY
B3Y1 = B3Y2 - HGTH
B4X1 = SPCINGX
B4X2 = B4X1 + WDTH
B4Y2 = GETMAXY - SPCINGY
B4Y1 = B4Y2 - HGTH
DRWBOX 1, 15, B1X1, B1Y1, B1X2, B1Y2
DRWBOX 1, 15, B2X1, B2Y1, B2X2, B2Y2
DRWBOX 1, 15, B3X1, B3Y1, B3X2, B3Y2
DRWBOX 1, 15, B4X1, B4Y1, B4X2, B4Y2
B1X1 = B1X1 + 1
B1Y1 = B1Y1 + 1
B1X2 = B1X2 - 1
B1Y2 = B1Y2 - 1
B2X1 = B2X1 + 1
B2Y1 = B2Y1 + 1
B2X2 = B2X2 - 1
B2Y2 = B2Y2 - 1
B3X1 = B3X1 + 1
B3Y1 = B3Y1 + 1
B3X2 = B3X2 - 1
B3Y2 = B3Y2 - 1
B4X1 = B4X1 + 1
B4Y1 = B4Y1 + 1
B4X2 = B4X2 - 1
B4Y2 = B4Y2 - 1
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
SETVIEW B1X1, B1Y1, B1X2, B1Y2
FILLVIEW (10)
SETVIEW B2X1, B2Y1, B2X2, B2Y2
FILLVIEW (12)
SETVIEW B3X1, B3Y1, B3X2, B3Y2
FILLVIEW (13)
SETVIEW B4X1, B4Y1, B4X2, B4Y2
FILLVIEW (14)
SETVIEW 0, 0, GETMAXX, GETMAXY
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* SET UP WINDOW AND SHOW AREA FILL
'*************************************************************************
FILLSCREEN (0)
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "FILLAREA (Xseed,Yseed,BrdrCol,FilCol)"
DRWSTRING 1, 7, 0, A$, 10, 16
DRWBOX 1, 15, 5, 35, GETMAXX - 4, GETMAXY - 4
SETVIEW 6, 36, GETMAXX - 5, GETMAXY - 5
Colr = 1
FOR I = 0 TO GETMAXX \ 10
X = 50 + RND * (GETMAXX - 50)
Y = 50 + RND * (GETMAXY - 50)
RADX = 2 + RND * GETMAXX \ 20
RADY = 2 + RND * GETMAXX \ 20
DRWELLIPSE 1, Colr, X, Y, RADX, RADY
Colr = Colr + 1
IF Colr > 9 THEN
Colr = 1
END IF
NEXT I
FOR I = 0 TO GETMAXX \ 15
X = 50 + RND * (GETMAXX - 50)
Y = 50 + RND * (GETMAXY - 50)
RADX = 2 + RND * GETMAXX \ 20
RADY = 2 + RND * GETMAXX \ 20
DRWELLIPSE 1, 12, X, Y, RADX, RADY
NEXT I
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
FILLAREA 7, 37, 12, 10
GETKEY RET$
SETVIEW 0, 0, GETMAXX, GETMAXY
IF (RET$ = "S") OR (RET$ = "Q") THEN
EXIT SUB
END IF
'*************************************************************************
'* SET UP WINDOW AND SHOW COLOR FILL
'*************************************************************************
FILLSCREEN (0)
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "FILLCOLOR (Xseed,Yseed,OldCol,FilCol)"
DRWSTRING 1, 7, 0, A$, 10, 16
DRWBOX 1, 15, 5, 35, GETMAXX - 4, GETMAXY - 4
SETVIEW 6, 36, GETMAXX - 5, GETMAXY - 5
Colr = 1
FOR I = 0 TO GETMAXX \ 10
X = 50 + RND * (GETMAXX - 50)
Y = 50 + RND * (GETMAXY - 50)
RADX = 2 + RND * GETMAXX \ 20
RADY = 2 + RND * GETMAXX \ 20
DRWELLIPSE 1, Colr, X, Y, RADX, RADY
Colr = Colr + 1
IF Colr > 9 THEN
Colr = 1
END IF
NEXT I
FOR I = 0 TO GETMAXX \ 15
X = 50 + RND * (GETMAXX - 50)
Y = 50 + RND * (GETMAXY - 50)
RADX = 2 + RND * GETMAXX \ 20
RADY = 2 + RND * GETMAXX \ 20
DRWELLIPSE 1, 12, X, Y, RADX, RADY
NEXT I
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
FILLCOLOR 7, 37, 0, 10
SETVIEW 0, 0, GETMAXX, GETMAXY
GETKEY RET$
END SUB
SUB DOPAL (RET$)
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 4: Palette functions"
PALSET ORGPAL, 0, 255
'*************************************************************************
'* SHOW PALETTE SET/GET
'*************************************************************************
FILLSCREEN (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "PALGET (Palette$,FirstColr,LastColr) PALSET (Palette$,FirtColr,LastColr)"
DRWSTRING 1, 7, 0, A$, 10, 16
Colr = 16
X1 = 10
X2 = GETMAXX - 9
Y1 = 35
Y2 = GETMAXY - 9
I = 0
WHILE Y1 + I < Y2 - I
DRWBOX 1, Colr, X1 + I, Y1 + I, X2 - I, Y2 - I
Colr = Colr + 1
IF Colr > 255 THEN
Colr = 16
END IF
I = I + 1
WEND
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN (0)
PALSET Pal, 16, 255
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
PALSET Pal, 16, 255
'*************************************************************************
'* SHOW PALETTE AUTO FADE OUT/IN
'*************************************************************************
A$ = "PALIOAUTO (Palette$,FirstColr,LastColr,Speed) "
DRWSTRING 1, 7, 0, A$, 10, 16
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
PALIOAUTO Pal, 16, 255, -2
PALIOAUTO Pal, 16, 255, 2
'*************************************************************************
'* SHOW PALETTE AUTO FADE TO
'*************************************************************************
A$ = "PALCHGAUTO (Palette$,NewPalette$,FirstColr,LastColr,Speed)"
DRWSTRING 1, 7, 0, A$, 10, 16
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
PALCHGAUTO Pal, PAL2, 16, 255, 2
PALCHGAUTO PAL2, Pal, 16, 255, 2
'*************************************************************************
'* SHOW PALETTE ROTATE
'*************************************************************************
A$ = "PALROTATE (Palette$,FirstColr,LastColr,Shift) "
DRWSTRING 1, 7, 0, A$, 10, 16
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
FOR I = 0 TO 240
PALROTATE Pal, 16, 255, 2
PALGET Pal, 16, 255
NEXT I
FOR I = 0 TO 120
PALROTATE Pal, 16, 255, -8
PALGET Pal, 16, 255
NEXT I
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
END SUB
SUB DOPRIMS (RET$)
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 1: Primitives"
PALSET Pal, 0, 255
'*************************************************************************
'* DRAW SOME POINTS
'*************************************************************************
FILLSCREEN (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "DRWPOINT (Mode,Color,X1,Y1,X2,Y2)"
DRWSTRING 1, 7, 0, A$, 10, 18
SETVIEW 0, 32, GETMAXX, GETMAXY
Colr = 1
NUMOF = GETMAXX * 2
FOR A = 0 TO NUMOF
X1 = RND * GETMAXX
Y1 = RND * GETMAXY
DRWPOINT 1, Colr, X1, Y1
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
NEXT A
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* DRAW SOME LINES
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "DRWLINE (Mode,Color,X1,Y1,X2,Y2)"
DRWSTRING 1, 7, 0, A$, 10, 18
SETVIEW 0, 32, GETMAXX, GETMAXY
NUMOF = GETMAXX \ 6
FOR A = 0 TO NUMOF
X1 = RND * GETMAXX
Y1 = RND * GETMAXY
X2 = RND * GETMAXX
Y2 = RND * GETMAXY
DRWLINE 1, Colr, X1, Y1, X2, Y2
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
NEXT A
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* DRAW SOME BOXES
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "DRWBOX (Mode,Color,X1,Y1,X2,Y2)"
DRWSTRING 1, 7, 0, A$, 10, 18
SETVIEW 0, 32, GETMAXX, GETMAXY
NUMOF = GETMAXX \ 10
FOR A = 0 TO NUMOF
X1 = RND * GETMAXX
Y1 = RND * GETMAXY
X2 = RND * GETMAXX
Y2 = RND * GETMAXY
DRWBOX 1, Colr, X1, Y1, X2, Y2
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
NEXT A
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* DRAW SOME CIRCLES
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "DRWCIRCLE (Mode,Color,Cx,Cy,Radius)"
DRWSTRING 1, 7, 0, A$, 10, 18
SETVIEW 0, 32, GETMAXX, GETMAXY
NUMOF = GETMAXX \ 20
MAXRAD = GETMAXX \ 2
FOR A = 0 TO NUMOF
X = RND * GETMAXX
Y = RND * GETMAXY
RAD = RND * MAXRAD
DRWCIRCLE 1, Colr, X, Y, RAD
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
NEXT A
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* DRAW SOME ELLIPSES
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "DRWELLIPSE (Mode,Color,Cx,Cy,RadiusX,RadiusY)"
DRWSTRING 1, 7, 0, A$, 10, 18
SETVIEW 0, 32, GETMAXX, GETMAXY
NUMOF = GETMAXX \ 20
MAXRAD = GETMAXX \ 2
FOR A = 0 TO NUMOF
X = RND * GETMAXX
Y = RND * GETMAXY + 35
RADX = RND * MAXRAD
RADY = RND * MAXRAD
DRWELLIPSE 1, Colr, X, Y, RADX, RADY
Colr = Colr + 1
IF Colr > 15 THEN
Colr = 1
END IF
NEXT A
SETVIEW 0, 0, GETMAXX, GETMAXY
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
EXIT SUB
END IF
END SUB
SUB DOSCROLL (RET$)
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 7: Scroll functions"
PALSET Pal, 0, 255
FILLSCREEN (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
SPCNG = (GETMAXY - 32) \ 5
SKIP = (INT((GETMAXX + 1) / 160 + .9) * 2) - 1
Num = SPCNG / 2 / SKIP
IF SPCNG / 2 <> INT(SPCNG / 2) THEN
SPCNG = SPCNG + 1
END IF
X1 = ((GETMAXX + 1) \ 2) - SPCNG
Y1 = (((GETMAXY + 1 - 32) \ 2) + 32) - SPCNG
X2 = ((GETMAXX + 1) \ 2) + SPCNG
Y2 = (((GETMAXY + 1 - 32) \ 2) + 32) + SPCNG
DRWBOX 1, 12, X1, Y1, X2, Y2
X1 = X1 + 1
Y1 = Y1 + 1
X2 = X2 - 1
Y2 = Y2 - 1
Colr = 16
TEXT$ = "TEXT text TEXT"
'*************************************************************************
'* SHOW SCROLLUP
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
A$ = "SCROLLUP (X1,Y1,X2,Y2,NumLines,FillColr)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW X1, Y1, X2, Y2
FILLVIEW (0)
NUMOF = GETMAXX \ 10
FOR A = 0 TO NUMOF
X = RND * GETMAXX
Y = RND * GETMAXY
I = RND * GETMAXX
J = RND * GETMAXY
DRWLINE 1, Colr, X, Y, I, J
Colr = Colr + 3
IF Colr > 255 THEN
Colr = 16
END IF
NEXT A
DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
FOR A = 0 TO Num
SCROLLUP X1, Y1, X2, Y2, SKIP, 0 '* HERE IT IS!
NEXT A
'*************************************************************************
'* SHOW SCROLLLT
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
A$ = "SCROLLLT (X1,Y1,X2,Y2,NumLines,FillColr)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW X1, Y1, X2, Y2
FILLVIEW (0)
NUMOF = GETMAXX \ 10
FOR A = 0 TO NUMOF
X = RND * GETMAXX
Y = RND * GETMAXY
I = RND * GETMAXX
J = RND * GETMAXY
DRWLINE 1, Colr, X, Y, I, J
Colr = Colr + 3
IF Colr > 255 THEN
Colr = 16
END IF
NEXT A
DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
FOR A = 0 TO Num
SCROLLLT X1, Y1, X2, Y2, SKIP, 0 '* HERE IT IS!
NEXT A
'*************************************************************************
'* SHOW SCROLLDN
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
A$ = "SCROLLDN (X1,Y1,X2,Y2,NumLines,FillColr)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW X1, Y1, X2, Y2
FILLVIEW (0)
NUMOF = GETMAXX \ 10
FOR A = 0 TO NUMOF
X = RND * GETMAXX
Y = RND * GETMAXY
I = RND * GETMAXX
J = RND * GETMAXY
DRWLINE 1, Colr, X, Y, I, J
Colr = Colr + 3
IF Colr > 255 THEN
Colr = 16
END IF
NEXT A
DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
TIM! = TIMER
FOR A = 0 TO Num
SCROLLDN X1, Y1, X2, Y2, SKIP, 0 '* HERE IT IS!
NEXT A
TIM3! = TIMER - TIM!
'*************************************************************************
'* SHOW SCROLLRT
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
A$ = "SCROLLRT (X1,Y1,X2,Y2,NumLines,FillColr)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW X1, Y1, X2, Y2
FILLVIEW (0)
NUMOF = GETMAXX \ 10
FOR A = 0 TO NUMOF
X = RND * GETMAXX
Y = RND * GETMAXY
I = RND * GETMAXX
J = RND * GETMAXY
DRWLINE 1, Colr, X, Y, I, J
Colr = Colr + 3
IF Colr > 255 THEN
Colr = 16
END IF
NEXT A
DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
FOR A = 0 TO Num
SCROLLRT X1, Y1, X2, Y2, SKIP, 0 '* HERE IT IS!
NEXT A
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
END SUB
SUB DOTEXT (RET$)
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 6: Text functions"
PALSET Pal, 0, 255
'*************************************************************************
'* SHOW ALTERNATE PRINT DIRECTIONS
'*************************************************************************
FILLSCREEN (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "DRWSTRING(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
Colr = 16
FOR Y = 32 TO GETMAXY STEP 20
DRWSTRING 1, Colr, 0, A$, 0, Y
Colr = Colr + 5
IF Colr > 255 THEN
Colr = 16
END IF
NEXT Y
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
EXIT SUB
END IF
FILLVIEW (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
A$ = "DRWSTRINGLT(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
FOR X = 0 TO GETMAXX STEP 20
DRWSTRINGLT 1, Colr, 0, A$, X, GETMAXY
Colr = Colr + 5
IF Colr > 255 THEN
Colr = 16
END IF
NEXT X
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
EXIT SUB
END IF
FILLVIEW (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
A$ = "DRWSTRINGDN(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
Colr = 16
FOR Y = GETMAXY TO 32 STEP -20
DRWSTRINGDN 1, Colr, 0, A$, GETMAXX, Y
Colr = Colr + 5
IF Colr > 255 THEN
Colr = 16
END IF
NEXT Y
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
EXIT SUB
END IF
FILLVIEW (0)
SETVIEW 0, 0, GETMAXX, GETMAXY
A$ = "DRWSTRINGRT(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
FOR X = GETMAXX TO 0 STEP -20
DRWSTRINGRT 1, Colr, 0, A$, X, 32
Colr = Colr + 5
IF Colr > 255 THEN
Colr = 16
END IF
NEXT X
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
SETVIEW 0, 0, GETMAXX, GETMAXY
FILLSCREEN (0)
EXIT SUB
END IF
END SUB